home *** CD-ROM | disk | FTP | other *** search
/ Mac-Source 1994 July / Mac-Source_July_1994.iso / C and C++ / Compilers⁄Interps / kevoSource / portPrim.c < prev    next >
Text File  |  1993-05-13  |  27KB  |  1,226 lines
  1. /* Kevo -- a prototype-based object-oriented language */
  2. /* (c) Antero Taivalsaari 1991-1993                   */
  3. /* Some parts (c) Antero Taivalsaari 1986-1988           */
  4. /* portPrim.c: Non-portable primitives                  */
  5.  
  6. /*
  7.     This file contains Kevo primitives which are not portable
  8.     from one machine platform to another.
  9.  
  10.     Correct machine platform can be selected in file 'port.h'.
  11. */
  12.  
  13. #include "global.h"
  14. #include "portGlobal.h"
  15.  
  16. /*---------------------------------------------------------------------------*/
  17. /* Host system specific primitives */ 
  18.  
  19. /* system    ( str --  ) */
  20. /* send a string to the host system for execution */
  21. void pSystem()
  22. {
  23. #ifdef UNIX
  24.   (void)system((char*)popData());
  25. #endif
  26.   (void)popData();
  27. }
  28.  
  29.  
  30. /* bye        ( -- ) */
  31. /* exit from Kevo to the host system */
  32. void pBye()
  33. {
  34.   fprintf(confile, "== Exiting Kevo ==\n");
  35.   ZeroScrap();
  36.   TEToScrap();
  37.   ExitToShell();
  38. }
  39.  
  40.  
  41. /*---------------------------------------------------------------------------*/
  42. /* Timing primitives */ 
  43.  
  44. /* clock    (  -- clock ) */
  45. /* return the processor time used by the program */
  46. void pClock()
  47. {
  48.   pushData((int)TickCount());
  49. }
  50.  
  51.  
  52. /* The following two definitions implement a very useful timer loop */
  53. /* The loop contents will be executed (at least) for a certain amount */
  54. /* of milliseconds */
  55.  
  56. /* (msecsDo)    ( msecs -- ) */
  57. /* loop beginning: calculate time limit  */
  58. /* if given time is zero, skip the whole loop */
  59. void poTimerDo()
  60. {
  61.   int param = popData();
  62.   int time = param * 6 / 10;    /* Convert milliseconds to Mac clock ticks */
  63.  
  64.   if (param == 0) ip += (int)*ip; /* Skip over the whole loop */
  65.   else {
  66.      pushReturn((int*)(ip+(int)*ip)); /* Push loop exit address */
  67.      pushReturn((int*)(time+TickCount())); /* Push exit time */
  68.      pushReturn((int*)1);          /* The indexing begins from 1 */
  69.      ip++;                          /* Skip over the jump offset */
  70.   }
  71. }
  72.  
  73.  
  74. /* (msecsLoop)    ( -- ) */
  75. /* timing loop end: if current time is greater than limit, end loop */
  76. /* else increment index by one */
  77. void poTimerLoop()
  78. {
  79.   int  index = (int)topReturn;
  80.   int  limit = (int)secondReturn;
  81.  
  82.   if (TickCount() < limit) {   /* If time is still below the limit */
  83.     topReturn=(int*)(index+1); /* Increment index */
  84.     ip += (int)*ip;         /* and go back to the beginning of the loop */
  85.   } 
  86.   else { 
  87.     nPopReturn(3);        /* Otherwise remove return stack effects */
  88.     ip++;                /* and continue (skip the address) */
  89.   }
  90. }
  91.  
  92.  
  93. /* eventDelay    (  -- address ) */
  94. /* return the address of our event delay variable */
  95. /* Determines the pause until events will be checked again (in 1/60 secs) */
  96. void pEventDelay()
  97. {
  98.   pushData((int)&eventDelay);
  99. }
  100.  
  101.  
  102. /* eventSlice    (  -- address ) */
  103. /* return the address of our event slice variable */
  104. /* Determines how much other Mac tasks will receive time (in 1/60 secs) */
  105. /* when events are being checked */
  106. void pEventSlice()
  107. {
  108.   pushData((int)&eventSlice);
  109. }
  110.  
  111.  
  112. /*---------------------------------------------------------------------------*/
  113. /* Memory primitives */
  114.  
  115. /* room        (  -- memoryAvailable )
  116. /* return the amount of free memory */
  117. void pRoom()
  118. {
  119.     pushData(FreeMem());
  120. }
  121.  
  122.  
  123. /* lowMem    (  -- lowAddress )
  124. /* return the lowest location of the Kevo system */
  125. /* (beginning of the application heap) */
  126. void pLowMem()
  127. {
  128.     pushData((int)lowMemLimit);
  129. }
  130.  
  131.  
  132. /* highMem    (  -- highAddress )
  133. /* return the highest location of the Kevo system */
  134. /* (end of the application heap) */
  135. void pHighMem()
  136. {
  137.     pushData((int)highMemLimit);
  138. }
  139.  
  140.  
  141. /*---------------------------------------------------------------------------*/
  142. /* Input/output primitives */
  143.  
  144. /*
  145.   To allow multitasking, Kevo's input/output operations must
  146.   operate on a character at a time basis. In a mainframe environment,
  147.   this obviously consumes more processor time. However, note that all
  148.   I/O primitives call 'yield' so that within the Kevo system processor
  149.   execution time is not wasted in e.g. waiting for a next keypress
  150.   from the keyboard. Important: 'yield' can only be the last operation in
  151.   a primitive.
  152. */
  153.  
  154.  
  155. /* emit        ( b -- ) */
  156. /* emit a single character to outfile */
  157. void pEmit()
  158. {
  159.   WindowPtr thisWindow;
  160.   TEHandle    thisTE;
  161.   char         c = (char)popData();
  162.   
  163.     if (!outfile) {
  164.  
  165.         /* If the task has no associated window, ignore printing */
  166.         thisWindow = (WindowPtr)(*up)->window;
  167.         if (!thisWindow) return;
  168.  
  169.         if (thisTE = getWindowTE(thisWindow)) TEKey(c, thisTE); 
  170.         else {    /* window has no associated TE -> use QuickDraw */
  171.             GrafPtr savePort;
  172.  
  173.             GetPort(&savePort);
  174.             SetPort(thisWindow);
  175.             DrawChar(c);
  176.             SetPort(savePort);
  177.         }
  178.     } 
  179.     else {    /* print to file */
  180.         fprintf(outfile, "%c", c);
  181.         /* fflush(outfile); */
  182.     }  
  183.     yield();
  184. }
  185.  
  186.  
  187. /* type        ( addr -- ) */
  188. /* type a whole string to outfile */
  189. void pType()
  190. {
  191.   WindowPtr    thisWindow;
  192.   TEHandle     thisTE;
  193.   char*     str = (char*)popData();
  194.   int         len = strlen(str);
  195.   
  196.     if (!outfile) {
  197.  
  198.         /* If the task has no associated window, ignore printing */
  199.         thisWindow = (WindowPtr)(*up)->window;
  200.         if (!thisWindow) return;
  201.  
  202.         if (thisTE = getWindowTE(thisWindow)) TEInsert(str, len, thisTE);
  203.         else {    /* window has no associated TE -> use QuickDraw */
  204.             GrafPtr savePort;
  205.  
  206.             GetPort(&savePort);
  207.             SetPort(thisWindow);
  208.             DrawString(CtoPstr(strcpy(charbuffer, str)));
  209.             SetPort(savePort);
  210.         }
  211.     }
  212.     else {    /* print to file */
  213.          fprintf(outfile, "%s", str);
  214.           fflush(outfile);    
  215.     }    
  216.     yield();
  217. }
  218.  
  219.  
  220. /* page         ( -- ) */
  221. /* Clear the screen or start new page */
  222. void pPage()
  223. {
  224.   WindowPtr    thisWindow;
  225.   TEHandle    thisTE;
  226.     
  227.     if (!outfile) {
  228.  
  229.         /* If the task has no associated window, ignore printing */
  230.         thisWindow = (WindowPtr)(*up)->window;
  231.         if (!thisWindow) return;
  232.  
  233.         if (thisTE = getWindowTE(thisWindow)) { 
  234.               GrafPtr savePort;
  235.  
  236.             GetPort(&savePort);
  237.             SetPort(thisWindow);
  238.  
  239.               TESetText("", 0, thisTE);
  240.             EraseRect(&(*thisTE)->viewRect); 
  241.             InvalRect(&(*thisTE)->viewRect); 
  242.             SetPort(savePort);
  243.         }
  244.         else {     /* window has no associated TE -> use QuickDraw */
  245.             GrafPtr savePort;
  246.   
  247.             GetPort(&savePort);
  248.             SetPort(thisWindow);
  249.               EraseRect(&(thisWindow->portRect)); 
  250.             /* InvalRect(&(thisWindow->portRect)); updates not implemented */
  251.             MoveTo(4, 16);
  252.             SetPort(savePort);
  253.         }
  254.       }
  255.       else fprintf(outfile, "\f");
  256.       yield();
  257. }
  258.  
  259.  
  260. /* bell        (  -- ) */
  261. /* Sound the bell */
  262. void pBell()
  263. {
  264.     if (!outfile) SysBeep(1);
  265.     else fprintf(outfile, "\a");
  266.     yield();
  267. }
  268.  
  269.  
  270. /* cr        (  -- ) */
  271. /* print carriage return */
  272. void pCr()
  273. {
  274.   ownCr();
  275.   yield();
  276. }
  277.  
  278.  
  279. /* spaces    ( n --  ) */
  280. /* print n spaces */
  281. /* xxx This is quite a stupid implementation */
  282. void pSpaces()
  283. {
  284.   int n = popData();
  285.   int i = 0;
  286.   for ( ; i < n; i++) charbuffer[i] = ' ';
  287.   charbuffer[n] = 0;
  288.   ownPrintf("%s", charbuffer);
  289. }
  290.  
  291.  
  292. /* .        ( l -- ) */
  293. /* print the topmost data stack item to outfile as a signed integer */
  294. void pPrint()
  295. {
  296.   ownPrintf("%d ", popData());
  297.   yield();
  298. }
  299.  
  300.  
  301. /* u.        ( l -- ) */
  302. /* print the topmost data stack item to outfile as an unsigned integer */
  303. void pUPrint()
  304. {
  305.   ownPrintf("%u ", (unsigned)popData());
  306.   yield();
  307. }
  308.  
  309.  
  310. /* h.        ( l -- ) */
  311. /* print the topmost data stack item to outfile as a hex number */
  312. /* Before printing, do appropriate formatting to the number */
  313. void pHPrint()
  314. {
  315.   char* format;
  316.   int number = popData();
  317.  
  318.   if (number > 0xffff) format = "%08x ";
  319.   else if (number > 0xff) format = "%04x ";
  320.   else format = "%02x ";
  321.  
  322.   ownPrintf(format, number);
  323.   yield();
  324. }
  325.  
  326.  
  327. /* key?        ( -- b ) */
  328. /* check if any key is currently being pressed without waiting for it */
  329. /* return the key or FALSE */
  330. void pQKey()
  331. {
  332.   int c;
  333.  
  334.   (*up)->endOfFile = FALSE;
  335.  
  336.   if (!infile) {
  337.       c = getFromKeyBuffer(up);
  338.   }
  339.   else {
  340.     if ((c = fgetc(infile)) == EOF) {
  341.         c = 0;
  342.         (*up)->endOfFile = TRUE;
  343.         pPopInfile();
  344.     }
  345.   }
  346.   pushData(c);
  347.   yield();
  348. }
  349.  
  350.  
  351. /* textAvailable    (  -- address TRUE <OR> FALSE ) */
  352. /* Check if we have a command line available for the parser */
  353. /* Return the address of the command line or FALSE */
  354. void pTextAvailable()
  355. {
  356.   char c;
  357.   char* start;
  358.   char* target;    
  359.  
  360.     (*up)->endOfFile = FALSE;
  361.  
  362.     if (infile) {
  363.         /*  Buffer must be erased because otherwise keypresses 
  364.             from the keyboard might scramble the contents of 
  365.             the key buffer during file loading 
  366.         */
  367.         eraseKeyBuffer(up);
  368.         
  369.         while(TRUE) {
  370.             if ((c = fgetc(infile)) == EOF) {
  371.                 (*up)->endOfFile = TRUE;
  372.                 pPopInfile();
  373.                 break;
  374.             }
  375.             if (c == CR || c == LF) break;
  376.             putToKeyBuffer(up, c); 
  377.         }
  378.         putToKeyBuffer(up, 0);
  379.         putToKeyBuffer(up, 0);
  380.     
  381.         target = (char*)((*up)->textBuffer->mfa);
  382.           start = &(target[((*up)->textTail)]);
  383.         (*up)->textTail = (*up)->textHead;
  384.         pushData((int)start);        
  385.         pushData(TRUE);
  386.     }
  387.     else {
  388.         int avail;
  389.  
  390.         /* Check if there is a line available in the task-specific text buffer */
  391.         pushData(avail = (int)lineAvailable(up));
  392.         if (avail) pushData(TRUE);
  393.     }
  394.     yield();
  395. }
  396.  
  397.  
  398. /* eraseText    (  --  ) */
  399. /* Erase the text buffer of the currently executing task */
  400. void pEraseText()
  401. {
  402.     eraseKeyBuffer(up);
  403. }
  404.  
  405.  
  406. /*---------------------------------------------------------------------------*/
  407. /* GUI window primitives */
  408.  
  409. /* <buildWindow>    ( name -- windowHandle ) */
  410. /* Build a new plain window (with no TE facilities) */
  411. void pBuildWindow()
  412. {
  413.   char* str = (char*)popData();
  414.   WindowPtr newWindow = buildWindow(CtoPstr(strcpy(charbuffer, str)));
  415.  
  416.     if (newWindow) {
  417.         ShowWindow(newWindow);
  418.         pushData((int)newWindow);
  419.     }
  420.     else {
  421.         if (!supervisor) {
  422.             ownPrintf("-- Out of memory in allocating new window");
  423.             execute((*up)->errorVector);
  424.         }
  425.         ownLongJmp();
  426.     }
  427.     yield();
  428. }    
  429.     
  430.     
  431. /* <buildTEWindow>    ( name -- windowHandle ) */
  432. /* Build a new window (with TE facilities) */
  433. void pBuildTEWindow()
  434. {
  435.   char* str = (char*)popData();
  436.   WindowPtr newWindow = buildTEWindow(CtoPstr(strcpy(charbuffer, str)));
  437.  
  438.     if (newWindow) {
  439.         ShowWindow(newWindow);
  440.         pushData((int)newWindow);
  441.     }
  442.     else {
  443.         if (!supervisor) {
  444.             ownPrintf("-- Out of memory in allocating new window");
  445.             execute((*up)->errorVector);
  446.         }
  447.         ownLongJmp();
  448.     }
  449.     yield();
  450. }    
  451.     
  452.     
  453. /* <buildGRTask>    (  -- task ) */  
  454. /* Create a new foreground task by copying the current one */
  455. /* The task has an own window but no TextEdit facilities */
  456. /* This makes the window ideal for displaying graphics etc. */
  457. /* Task's operation is initialized to 'boot' but it is not activated */
  458. void pBuildGRTask()
  459. {
  460.   TASK** newTask = buildTask();
  461.   WindowPtr newWindow;
  462.   
  463.     /* Build a new window for the newly created task */
  464.     newWindow = buildWindow("\pKevo Task");
  465.     if (newWindow) {
  466.         ShowWindow(newWindow);  
  467.           (*newTask)->window = (int*)newWindow;
  468.     }
  469.  
  470.     pushData((int)newTask);
  471.     yield();
  472. }
  473.  
  474.  
  475. /* <buildTETask>    (  -- task ) */  
  476. /* Create a new foreground task by copying the current one */
  477. /* The task has its own window with TE facilities */
  478. /* This makes it ideal for displaying text (and also graphics) */
  479. /* Task's operation is initialized to 'boot' but it is not activated */
  480. void pBuildTETask()
  481. {
  482.   TASK** newTask = buildTask();
  483.   WindowPtr newWindow;
  484.   
  485.     /* Build a new TextEdit window for the newly created task */
  486.     newWindow = buildTEWindow("\pKevo Task");
  487.     if (newWindow) {
  488.         (*newTask)->window = (int*)newWindow;
  489.         ShowWindow(newWindow);
  490.     }
  491.  
  492.     pushData((int)newTask);
  493.     yield();
  494. }
  495.  
  496.  
  497. /* showWindow        ( window --  ) */
  498. /* display a window */
  499. /* if it is the only window on the screen, it becomes active */
  500. void pShowWindow()
  501. {
  502.     ShowWindow((WindowPtr)popData());
  503.     yield();
  504. }
  505.  
  506.  
  507. /* hideWindow        ( window --  ) */
  508. /* hide and deactivate a window */
  509. void pHideWindow()
  510. {
  511.     HideWindow((WindowPtr)popData());
  512.     yield();
  513. }
  514.  
  515.  
  516. /* selectWindow        ( window --  ) */
  517. /* select and activate a window */
  518. void pSelectWindow()
  519. {
  520.     SelectWindow((WindowPtr)popData());
  521.     yield();
  522. }
  523.  
  524.  
  525. /* frontWindow        (  -- window ) */
  526. /* return the id of the frontmost (active) window */
  527. void pFrontWindow()
  528. {
  529.     pushData((int)FrontWindow());
  530. }
  531.  
  532.  
  533. /* nextWindow        ( window -- window ) */
  534. /* return the id of the next window in the Mac window list */
  535. void pNextWindow()
  536. {
  537.     WindowPeek thisWindow = (WindowPeek)topData;
  538.     topData = (int)thisWindow->nextWindow;
  539. }
  540.  
  541.  
  542. /* setWindowTitle    ( nameAddr window --  ) */
  543. /* Change the name of an existing window */
  544. void pSetWindowTitle()
  545. {
  546.   WindowPtr thisWindow = (WindowPtr)popData();
  547.   char* string    = (char*)popData();
  548.   
  549.       SetWTitle(thisWindow, CtoPstr(strcpy(charbuffer, string)));
  550.     yield();
  551. }
  552.  
  553.  
  554. /* getWindowTitle    ( window -- nameAddr ) */
  555. /* Get the name of a window */
  556. void pGetWindowTitle()
  557. {
  558.   WindowPtr thisWindow = (WindowPtr)topData;
  559.  
  560.     GetWTitle(thisWindow, (Str255*)charbuffer);
  561.     PtoCstr(charbuffer);
  562.     topData = (int)allocStrCpy(charbuffer);
  563. }
  564.  
  565.  
  566. /* setWindowSize    ( xSize ySize window --  ) */
  567. /* Set the size of a window */
  568. /* taking into account window kind (TE, Browser, etc.) */
  569. void pSetWindowSize()
  570. {
  571.   WindowPtr thisWindow = (WindowPtr)popData();
  572.   short ySize = (short)popData();
  573.   short xSize = (short)popData();
  574.   GrafPtr savePort;
  575.  
  576.     GetPort(&savePort);
  577.     SetPort(thisWindow);
  578.  
  579.     SizeWindow(thisWindow, xSize, ySize, TRUE);
  580.     doResizeWindow(thisWindow, xSize, ySize);
  581.     DrawGrowIcon(thisWindow);
  582.  
  583.     SetPort(savePort);
  584.     yield();
  585. }
  586.  
  587.  
  588. /* getWindowSize    ( window -- xSize ySize ) */
  589. /* Get the current size of the window */
  590. void pGetWindowSize()
  591. {
  592.   WindowPtr thisWindow = (WindowPtr)popData();
  593.   
  594.       pushData((int)thisWindow->portRect.right);
  595.       pushData((int)thisWindow->portRect.bottom);
  596. }
  597.  
  598.  
  599. /* setWindowLoc        ( xLoc yLoc window --  ) */
  600. /* Move the window to the requested location (in global coord's) */
  601. void pSetWindowLoc()
  602. {
  603.   WindowPtr thisWindow = (WindowPtr)popData();
  604.   short yLoc = (short)popData();
  605.   short xLoc = (short)popData();
  606.  
  607.     MoveWindow(thisWindow, xLoc, yLoc, FALSE);
  608.     yield();
  609. }
  610.  
  611.  
  612. /* getWindowLoc        ( window -- xSize ySize ) */
  613. /* Get the current locations of the window (in global coord's) */
  614. void pGetWindowLoc()
  615. {
  616.   WindowPtr thisWindow = (WindowPtr)popData();
  617.   
  618.     pushData(0 - thisWindow->portBits.bounds.left);
  619.     pushData(0 - thisWindow->portBits.bounds.top);
  620. }
  621.  
  622.  
  623. /* getWindowKind    ( window -- kind ) */
  624. /* Get the current size of a window */
  625. void pGetWindowKind()
  626. {
  627.   WindowPeek thisWindow = (WindowPeek)topData;
  628.   
  629.       topData = (int)thisWindow->windowKind;
  630. }
  631.  
  632.  
  633. /* TEDeactivate    ( window --  ) */
  634. /* Deactivate the (possible) TextEdit in the given window */
  635. /* This operation can be used to avoid the text cursor */
  636. /* interfering with graphics drawing */
  637. void pTEDeactivate()
  638. {
  639.   WindowPtr thisWindow = (WindowPtr)popData();
  640.   TEHandle thisTE;
  641.   
  642.     thisTE = getWindowTE(thisWindow);
  643.     if (thisTE) TEDeactivate(thisTE);
  644. }
  645.  
  646.  
  647. /* TEActivate    ( window --  ) */
  648. /* Activate the (possible) TextEdit in the given window */
  649. void pTEActivate()
  650. {
  651.   WindowPtr thisWindow = (WindowPtr)popData();
  652.   TEHandle thisTE;
  653.   
  654.     thisTE = getWindowTE(thisWindow);
  655.       if (thisTE) TEActivate(thisTE);
  656. }
  657.  
  658.  
  659. /*---------------------------------------------------------------------------*/
  660. /* GUI mouse & graphics primitives */
  661.  
  662. /* 
  663.    Note: all the graphics primitives below have been implemented so that they
  664.    affect only each task's own window on the screen. This is achieved by explicitly
  665.    changing the grafport before calling Mac QuickDraw routines.
  666. */
  667.  
  668. /* getMouse     (  -- x y ) */
  669. /* get mouse coordinates (in the task's own window coordinates) */
  670. /* Return (-1, -1) if the task has no associated window */
  671. void pGetMouse()
  672. {
  673.   Point pt;
  674.   GrafPtr savePort;
  675.   WindowPtr thisWindow = (WindowPtr)(*up)->window;
  676.   
  677.     if (!thisWindow) {
  678.         pushData(-1); pushData(-1); 
  679.         return;
  680.     }
  681.  
  682.     GetPort(&savePort);
  683.     SetPort(thisWindow);
  684.         
  685.     GetMouse(&pt);
  686.   
  687.     pushData((int)pt.h);
  688.     pushData((int)pt.v);
  689.  
  690.     SetPort(savePort);
  691. }
  692.  
  693.  
  694. /* button        (  -- flag ) */
  695. /* check if the mouse button is currently pressed in the current window */
  696. void pButton()
  697. {
  698.  
  699.     if (!Button()) pushData(FALSE);
  700.       else { 
  701.             WindowPtr thisWindow;
  702.  
  703.         if ((thisWindow = (WindowPtr)(*up)->window) == FrontWindow()) {
  704.               GrafPtr savePort;
  705.             Point pt;
  706.  
  707.             GetPort(&savePort);
  708.             SetPort(thisWindow);
  709.       
  710.             GetMouse(&pt);    
  711.  
  712.             if (PtInRect(pt, &thisWindow->portRect)) pushData(TRUE);
  713.             else pushData(FALSE);
  714.  
  715.             SetPort(savePort);
  716.         }        
  717.         else pushData(FALSE);
  718.     }
  719.     yield();
  720. }
  721.  
  722.  
  723. /* setPort        ( window --  ) */
  724. /* set the graf port */
  725. void pSetPort()
  726. {
  727.     SetPort((GrafPtr)popData());
  728. }
  729.  
  730.  
  731. /* getPort        (  -- window ) */
  732. /* get the current graf port */
  733. void pGetPort()
  734. {
  735.   GrafPtr port;
  736.   
  737.   GetPort(&port);
  738.   pushData((int)port);
  739. }
  740.  
  741.  
  742. /* showPen        (  --  ) */
  743. /* Show pen */
  744. void pShowPen()
  745. {
  746.   GrafPtr savePort;
  747.   WindowPtr thisWindow = (WindowPtr)(*up)->window;
  748.   
  749.     if (!thisWindow) return;
  750.  
  751.     GetPort(&savePort);
  752.     SetPort(thisWindow);
  753.       
  754.     ShowPen();
  755.  
  756.     SetPort(savePort);
  757. }
  758.  
  759.  
  760. /* hidePen        (  --  ) */
  761. /* Hide pen */
  762. void pHidePen()
  763. {
  764.   GrafPtr savePort;
  765.   WindowPtr thisWindow = (WindowPtr)(*up)->window;
  766.   
  767.     if (!thisWindow) return;
  768.  
  769.     GetPort(&savePort);
  770.     SetPort(thisWindow);
  771.       
  772.     HidePen();
  773.  
  774.     SetPort(savePort);
  775. }
  776.  
  777.  
  778. /* getPen        (  -- x y ) */
  779. void pGetPen()
  780. /* Get pen location */
  781. /* If the task has no associated window, return (-1, -1) */
  782. {
  783.   GrafPtr savePort;
  784.   Point   pt;
  785.   WindowPtr thisWindow = (WindowPtr)(*up)->window;
  786.   
  787.     if (!thisWindow) {
  788.         pushData(-1); pushData(-1);
  789.         return;
  790.     }
  791.  
  792.     GetPort(&savePort);
  793.     SetPort(thisWindow);
  794.       
  795.       GetPen(&pt);
  796.     pushData((int)pt.h);
  797.     pushData((int)pt.v);
  798.  
  799.     SetPort(savePort);
  800. }
  801.  
  802.  
  803. /* setPenSize    ( x y --  ) */
  804. /* Set pen size */
  805. void pSetPenSize()
  806. {
  807.   int y = popData();
  808.   int x = popData();
  809.   GrafPtr savePort;
  810.   WindowPtr thisWindow = (WindowPtr)(*up)->window;
  811.   
  812.     if (!thisWindow) return;
  813.  
  814.     GetPort(&savePort);
  815.     SetPort(thisWindow);
  816.       
  817.     PenSize(x, y);
  818.  
  819.     SetPort(savePort);
  820. }
  821.  
  822.  
  823. /* setPenMode    ( mode --  ) */
  824. /* Set pen mode (and, or, xor, bic, copy, ...) */
  825. void pSetPenMode()
  826. {
  827.   GrafPtr savePort;
  828.   WindowPtr thisWindow = (WindowPtr)(*up)->window;
  829.   
  830.     if (!thisWindow) {
  831.         (void)popData();
  832.         return;
  833.     }
  834.  
  835.     GetPort(&savePort);
  836.     SetPort(thisWindow);
  837.       
  838.     PenMode((short)popData());
  839.  
  840.     SetPort(savePort);
  841. }
  842.  
  843.  
  844. /* penNormalize    (  --  ) */
  845. /* Restore the initial characteristics of pen */
  846. void pPenNormalize()
  847. {
  848.   GrafPtr savePort;
  849.   WindowPtr thisWindow = (WindowPtr)(*up)->window;
  850.   
  851.     if (!thisWindow) return;
  852.  
  853.     GetPort(&savePort);
  854.     SetPort(thisWindow);
  855.       
  856.     PenNormal();
  857.  
  858.     SetPort(savePort);
  859. }
  860.  
  861.  
  862. /* moveTo    ( x y --  ) */
  863. /* Move pen to a certain location */
  864. void pMoveTo()
  865. {
  866.   int y = popData();
  867.   int x = popData();
  868.   GrafPtr savePort;
  869.   WindowPtr thisWindow = (WindowPtr)(*up)->window;
  870.   
  871.     if (!thisWindow) return;
  872.  
  873.     GetPort(&savePort);
  874.     SetPort(thisWindow);
  875.       
  876.     MoveTo(x, y);
  877.  
  878.     SetPort(savePort);
  879. }
  880.  
  881.  
  882. /* moveDelta    ( dx dy --  ) */
  883. /* Move pen relative to its current location */
  884. void pMoveDelta()
  885. {
  886.   int y = popData();
  887.   int x = popData();
  888.   GrafPtr savePort;
  889.   WindowPtr thisWindow = (WindowPtr)(*up)->window;
  890.   
  891.     if (!thisWindow) return;
  892.  
  893.     GetPort(&savePort);
  894.     SetPort(thisWindow);
  895.             
  896.     Move(x, y);
  897.  
  898.     SetPort(savePort);
  899. }
  900.  
  901.  
  902. /* lineTo        ( x y --  ) */
  903. /* Draw a line from current pen location to a certain point */
  904. void pLineTo()
  905. {
  906.   int y = popData();
  907.   int x = popData();
  908.   GrafPtr savePort;
  909.   WindowPtr thisWindow = (WindowPtr)(*up)->window;
  910.   
  911.     if (!thisWindow) return;
  912.  
  913.     GetPort(&savePort);
  914.     SetPort(thisWindow);
  915.       
  916.     LineTo(x, y);
  917.  
  918.     SetPort(savePort);
  919.     yield();
  920. }
  921.  
  922.  
  923. /* lineDelta    ( dx dy --  ) */
  924. /* Draw a line relative to pens current location */
  925. void pLineDelta()
  926. {
  927.   int y = popData();
  928.   int x = popData();
  929.   GrafPtr savePort;
  930.   WindowPtr thisWindow = (WindowPtr)(*up)->window;
  931.   
  932.     if (!thisWindow) return;
  933.  
  934.     GetPort(&savePort);
  935.     SetPort(thisWindow);
  936.       
  937.     Line(x, y);
  938.  
  939.     SetPort(savePort);
  940.     yield();
  941. }
  942.  
  943.  
  944. /* setTextFont    ( fontNumber --  ) */
  945. /* Set text font */
  946. void pSetTextFont()
  947. {
  948.   GrafPtr savePort;
  949.   WindowPtr thisWindow = (WindowPtr)(*up)->window;
  950.   
  951.     if (!thisWindow) {
  952.         (void)popData();
  953.         return;
  954.     }
  955.  
  956.     GetPort(&savePort);
  957.     SetPort(thisWindow);
  958.  
  959.      TextFont((short)popData());     
  960.  
  961.     SetPort(savePort);
  962. }    
  963.  
  964.  
  965. /* setTextFace    ( fontFace --  ) */
  966. /* Set text face (normal, bold, underlined, ...) */
  967. void pSetTextFace()
  968. {
  969.   GrafPtr savePort;
  970.   WindowPtr thisWindow = (WindowPtr)(*up)->window;
  971.   
  972.     if (!thisWindow) {
  973.         (void)popData();
  974.         return;
  975.     }
  976.  
  977.     GetPort(&savePort);
  978.     SetPort(thisWindow);
  979.  
  980.      TextFace((short)popData());     
  981.  
  982.     SetPort(savePort);
  983. }    
  984.  
  985.  
  986. /* setTextMode    ( fontMode --  ) */
  987. /* set text mode (and, or, xor, bic, copy, ... ) */
  988. void pSetTextMode()
  989. {
  990.   GrafPtr savePort;
  991.   WindowPtr thisWindow = (WindowPtr)(*up)->window;
  992.   
  993.     if (!thisWindow) {
  994.         (void)popData();
  995.         return;
  996.     }
  997.  
  998.     GetPort(&savePort);
  999.     SetPort(thisWindow);
  1000.  
  1001.      TextMode((short)popData());     
  1002.  
  1003.     SetPort(savePort);
  1004. }    
  1005.  
  1006.  
  1007. /* setTextSize    ( fontSize --  ) */
  1008. /* Set text font size */
  1009. void pSetTextSize()
  1010. {
  1011.   GrafPtr savePort;
  1012.   WindowPtr thisWindow = (WindowPtr)(*up)->window;
  1013.   
  1014.     if (!thisWindow) {
  1015.         (void)popData();
  1016.         return;
  1017.     }
  1018.  
  1019.     GetPort(&savePort);
  1020.     SetPort(thisWindow);
  1021.  
  1022.      TextSize((short)popData());     
  1023.  
  1024.     SetPort(savePort);
  1025. }    
  1026.  
  1027.  
  1028. /* drawChar        ( char --  ) */
  1029. /* Draw a character as graphics */
  1030. void pDrawChar()
  1031. {
  1032.   char c = (char)popData();
  1033.   GrafPtr savePort;
  1034.   WindowPtr thisWindow = (WindowPtr)(*up)->window;
  1035.   
  1036.     if (!thisWindow) return;
  1037.  
  1038.     GetPort(&savePort);
  1039.     SetPort(thisWindow);
  1040.  
  1041.     DrawChar(c);
  1042.  
  1043.     SetPort(savePort);
  1044.     yield();
  1045. }
  1046.  
  1047.  
  1048. /* drawString        ( stringAddr --  ) */
  1049. /* Draw a string as graphics */
  1050. void pDrawString()
  1051. {
  1052.   GrafPtr savePort;
  1053.   WindowPtr thisWindow = (WindowPtr)(*up)->window;
  1054.   
  1055.     if (!thisWindow) {
  1056.         (void)popData();
  1057.         return;
  1058.     }
  1059.  
  1060.     GetPort(&savePort);
  1061.     SetPort(thisWindow);
  1062.  
  1063.       DrawString(CtoPstr(strcpy(charbuffer, (char*)popData())));
  1064.  
  1065.     SetPort(savePort);
  1066.     yield();
  1067. }
  1068.  
  1069.  
  1070. /* wipeScreen    (  --  ) */
  1071. /* wipe the graphics off the window */
  1072. void pWipeScreen()
  1073. {
  1074.   GrafPtr savePort;
  1075.   WindowPtr thisWindow = (WindowPtr)(*up)->window;
  1076.   
  1077.     if (!thisWindow) return;
  1078.   
  1079.       GetPort(&savePort);
  1080.       SetPort(thisWindow);
  1081.       
  1082.       EraseRect(&(thisWindow->portRect)); 
  1083.       InvalRect(&(thisWindow->portRect)); 
  1084.  
  1085.     SetPort(savePort);
  1086.     yield();
  1087. }
  1088.  
  1089.  
  1090. /*---------------------------------------------------------------------------*/
  1091. /* Browser primitives */
  1092.  
  1093. /* browse        ( object --  ) */
  1094. /* open a browser for the given object */
  1095. void pBrowse()
  1096. {
  1097.   OBJECT* object = (OBJECT*)popData();
  1098.  
  1099.     /* 
  1100.         Note: this operation is not intended for opening 
  1101.         clone family browsers.
  1102.     */
  1103.     if (isContextObject(object)) openBrowser(object, NIL, BrowserWKind);
  1104.     yield();
  1105. }
  1106.  
  1107.  
  1108. /* unbrowse        ( object --  ) */
  1109. /* Delete the browser of the requested object if such a browser exists */
  1110. /* This operation is intended to be used mainly internally by the user interface */
  1111. void pUnbrowse()
  1112. {
  1113.   OBJECT* object = (OBJECT*)popData();
  1114.   WindowPtr browserWindow = findBrowser(object);
  1115.  
  1116.     if (browserWindow) deleteBrowser(browserWindow);
  1117.     yield();
  1118. }
  1119.  
  1120.  
  1121. /* cfBrowse        ( cloneFamilyObject --  ) */
  1122. /* Open a browser for a clone family object */
  1123. /* This operation is intended to be used internally by the user interface */
  1124. void pCfBrowse()
  1125. {
  1126.   OBJECT* object = (OBJECT*)popData();
  1127.  
  1128.     if (isContextObject(object)) openBrowser(object, NIL, CloneBrWKind);
  1129.     yield();
  1130. }
  1131.   
  1132.  
  1133. /*---------------------------------------------------------------------------*/
  1134. /* InitPortedPrims(): initialize the names of non-portable primitive operations */
  1135.  
  1136. void initPortedPrims()
  1137. {
  1138.   /* Host system specific primitives */
  1139.   addPair(rootContext, "system",     createPrimitive(pSystem));
  1140.   addPair(rootContext, "bye",         createPrimitive(pBye));
  1141.  
  1142.  
  1143.   /* Timing primitives */
  1144.   addPair(rootContext, "clock",     createPrimitive(pClock));
  1145.   addPair(rootContext, "(msecsDo)",    createPrimitive(poTimerDo)); hide();
  1146.   addPair(rootContext, "(msecsLoop)",createPrimitive(poTimerLoop)); hide();
  1147.   addPair(rootContext, "eventDelay",createPrimitive(pEventDelay));
  1148.   addPair(rootContext, "eventSlice",createPrimitive(pEventSlice));
  1149.  
  1150.  
  1151.   /* Memory primitives */
  1152.   addPair(rootContext, "room",         createPrimitive(pRoom));
  1153.   addPair(rootContext, "lowMem",     createPrimitive(pLowMem));
  1154.   addPair(rootContext, "highMem",     createPrimitive(pHighMem));
  1155.  
  1156.  
  1157.   /* Input/output primitives */
  1158.   addPair(rootContext, "emit",         createPrimitive(pEmit));
  1159.   addPair(rootContext, "type",         createPrimitive(pType));
  1160.   addPair(rootContext, "page",         createPrimitive(pPage));
  1161.   addPair(rootContext, ".",            createPrimitive(pPrint));
  1162.   addPair(rootContext, "u.",        createPrimitive(pUPrint));
  1163.   addPair(rootContext, "h.",        createPrimitive(pHPrint));
  1164.   addPair(rootContext, "bell",         createPrimitive(pBell));
  1165.   addPair(rootContext, "cr",         createPrimitive(pCr));
  1166.   addPair(rootContext, "spaces",     createPrimitive(pSpaces));
  1167.  
  1168.   addPair(rootContext, "key?",         createPrimitive(pQKey));
  1169.   addPair(rootContext, "textAvailable",createPrimitive(pTextAvailable));
  1170.   addPair(rootContext, "eraseText",    createPrimitive(pEraseText));
  1171.  
  1172.  
  1173.   /* GUI window primitives */
  1174.   addPair(rootContext, "<buildTEWindow>",createPrimitive(pBuildTEWindow)); hide();
  1175.   addPair(rootContext, "<buildWindow>",createPrimitive(pBuildWindow)); hide();
  1176.   addPair(rootContext, "<buildGRTask>",createPrimitive(pBuildGRTask)); hide();
  1177.   addPair(rootContext, "<buildTETask>",createPrimitive(pBuildTETask)); hide();
  1178.   addPair(rootContext, "showWindow",createPrimitive(pShowWindow));
  1179.   addPair(rootContext, "hideWindow",createPrimitive(pHideWindow));
  1180.   addPair(rootContext, "selectWindow",createPrimitive(pSelectWindow));
  1181.   addPair(rootContext, "frontWindow",createPrimitive(pFrontWindow));
  1182.   addPair(rootContext, "nextWindow",createPrimitive(pNextWindow));
  1183.   addPair(rootContext, "setWindowTitle",createPrimitive(pSetWindowTitle));
  1184.   addPair(rootContext, "getWindowTitle",createPrimitive(pGetWindowTitle));
  1185.   addPair(rootContext, "setWindowSize",createPrimitive(pSetWindowSize));
  1186.   addPair(rootContext, "getWindowSize",createPrimitive(pGetWindowSize));
  1187.   addPair(rootContext, "setWindowLoc", createPrimitive(pSetWindowLoc));
  1188.   addPair(rootContext, "getWindowLoc", createPrimitive(pGetWindowLoc));
  1189.   addPair(rootContext, "getWindowKind",createPrimitive(pGetWindowKind));
  1190.   addPair(rootContext, "TEDeactivate",createPrimitive(pTEDeactivate));
  1191.   addPair(rootContext, "TEActivate",createPrimitive(pTEActivate));
  1192.   
  1193.  
  1194.   /* GUI mouse & graphics primitives */
  1195.   addPair(rootContext, "getMouse",     createPrimitive(pGetMouse));
  1196.   addPair(rootContext, "button",    createPrimitive(pButton));
  1197.   addPair(rootContext, "setPort",     createPrimitive(pSetPort));
  1198.   addPair(rootContext, "getPort",    createPrimitive(pGetPort));
  1199.   addPair(rootContext, "hidePen",    createPrimitive(pHidePen));
  1200.   addPair(rootContext, "showPen",    createPrimitive(pShowPen));
  1201.   addPair(rootContext, "getPen",    createPrimitive(pGetPen));
  1202.   addPair(rootContext, "setPenSize",createPrimitive(pSetPenSize));
  1203.   addPair(rootContext, "setPenMode",createPrimitive(pSetPenMode));
  1204.   addPair(rootContext, "penNormalize",createPrimitive(pPenNormalize));
  1205.   addPair(rootContext, "moveTo",    createPrimitive(pMoveTo));
  1206.   addPair(rootContext, "moveDelta",    createPrimitive(pMoveDelta));
  1207.   addPair(rootContext, "lineTo",    createPrimitive(pLineTo));
  1208.   addPair(rootContext, "lineDelta",    createPrimitive(pLineDelta));
  1209.   addPair(rootContext, "setTextFont",createPrimitive(pSetTextFont));
  1210.   addPair(rootContext, "setTextFace",createPrimitive(pSetTextFace));
  1211.   addPair(rootContext, "setTextMode",createPrimitive(pSetTextMode));
  1212.   addPair(rootContext, "setTextSize",createPrimitive(pSetTextSize));
  1213.   addPair(rootContext, "drawChar",  createPrimitive(pDrawChar));
  1214.   addPair(rootContext, "drawString",createPrimitive(pDrawString));
  1215.   addPair(rootContext, "wipeScreen",createPrimitive(pWipeScreen));
  1216.  
  1217.  
  1218.   /* Browser primitives */
  1219.   addPair(rootContext, "browse",    createPrimitive(pBrowse));
  1220.   addPair(rootContext, "unbrowse",    createPrimitive(pUnbrowse));
  1221.   addPair(rootContext, "cfBrowse",    createPrimitive(pCfBrowse)); hide();
  1222.   
  1223. }
  1224.  
  1225.  
  1226.